home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 4.1 / Games-Dice.st < prev    next >
Text File  |  1993-07-24  |  5KB  |  201 lines
  1. "    NAME        Games-Dice
  2.     AUTHOR        tph@cs.man.ac.uk <Trevor Hopkins>
  3.     CONTRIBUTOR    mario@cs.man.ac.uk
  4.     FUNCTION alternative decision-making 
  5.     ST-VERSIONS    4.1
  6.     PREREQUISITES     
  7.     CONFLICTS    
  8.     DISTRIBUTION      world
  9.     VERSION        1.2
  10.     DATE        Sep 1992
  11. SUMMARY    Games-Dice
  12.     is a simple alternative to conventional decision-making!!
  13.  
  14. (Actually, a simple illustration of MVC.-ed)
  15.  
  16. Written by Trevor Hopkins, display by Bernard Horan.
  17. "!
  18. ControllerWithMenu subclass: #DiceController
  19.     instanceVariableNames: ''
  20.     classVariableNames: 'DiceMenu '
  21.     poolDictionaries: ''
  22.     category: 'Games-Dice'!
  23. DiceController comment:
  24. 'I represent the controller for a DiceView.'!
  25.  
  26.  
  27. !DiceController methodsFor: 'menu messages'!
  28.  
  29. menu
  30.     ^DiceMenu!
  31.  
  32. roll
  33.     model roll! !
  34.  
  35. !DiceController methodsFor: 'control defaults'!
  36.  
  37. controlActivity
  38.     self sensor keyboardPressed ifTrue:[self readKeyboard].
  39.     ^super controlActivity!
  40.  
  41. readKeyboard
  42.     "Roll the die if an 'r' or 'R' is typed.  
  43.     Set it to a particular value if a digit is typed."
  44.     | char digit |
  45.     char := self sensor keyboardEvent keyCharacter.
  46.     char asLowercase = $r ifTrue: [self roll].
  47.     (char isDigit and: [digit := char digitValue. digit between: 1 and: 6])
  48.         ifTrue: [model value: digit]! !
  49. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  50.  
  51. DiceController class
  52.     instanceVariableNames: ''!
  53.  
  54.  
  55. !DiceController class methodsFor: 'class initialization'!
  56.  
  57. initialize
  58.     "DiceController initialize"
  59.     "Initialize the menu."
  60.     super initialize.
  61.     DiceMenu := PopUpMenu labels: 'roll' values: #(roll)! !
  62.  
  63. Model subclass: #Dice
  64.     instanceVariableNames: 'value randomGenerator '
  65.     classVariableNames: ''
  66.     poolDictionaries: ''
  67.     category: 'Games-Dice'!
  68. Dice comment:
  69. 'I represent a single Dice (strictly, a DIE).  I respond to the roll message to generate a new random number.'!
  70.  
  71.  
  72. !Dice methodsFor: 'accessing'!
  73.  
  74. value
  75.     "Answer with the value represented by the receiver."
  76.  
  77.     ^value!
  78.  
  79. value: aValue
  80.     "This is how to load the die!!"
  81.     value := aValue.
  82.     self changed! !
  83.  
  84. !Dice methodsFor: 'initialize-release'!
  85.  
  86. initialize
  87.     "Initialize the random number generator, and set up the initial
  88.      state of the receiver."
  89.  
  90.     randomGenerator := Random new.
  91.     self rollDice! !
  92.  
  93. !Dice methodsFor: 'modifying'!
  94.  
  95. roll
  96.     "Update the dice value randomly several times, to give the impression
  97.      of a real roll."
  98.  
  99.     6 timesRepeat: [
  100.         self rollDice.
  101.         self changed]!
  102.  
  103. rollDice
  104.     "Update the dice value randomly."
  105.  
  106.     value := (randomGenerator next * 6 + 1) truncated! !
  107. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  108.  
  109. Dice class
  110.     instanceVariableNames: ''!
  111.  
  112.  
  113. !Dice class methodsFor: 'instance creation'!
  114.  
  115. new
  116.     "Answer with a new instance of the receiver."
  117.  
  118.     ^super new initialize! !
  119.  
  120. View subclass: #DiceView
  121.     instanceVariableNames: 'spot spotWidth spotHeight '
  122.     classVariableNames: ''
  123.     poolDictionaries: ''
  124.     category: 'Games-Dice'!
  125. DiceView comment:
  126. 'I know how to display a Dice in a viewable manner.'!
  127.  
  128.  
  129. !DiceView methodsFor: 'controller access'!
  130.  
  131. defaultControllerClass
  132.     ^DiceController! !
  133.  
  134. !DiceView methodsFor: 'displaying'!
  135.  
  136. displayOn: aGraphicsContext 
  137.     | box cent offset |
  138.     box := self bounds.
  139.     cent := box center.
  140.     offset := cent - (spotWidth // 2 @ (spotHeight // 2)).
  141.     (#(1 3 5 ) includes: model value)
  142.         ifTrue: [aGraphicsContext displayImage: spot at: offset].
  143.     (#(2 3 4 5 6 ) includes: model value)
  144.         ifTrue: 
  145.             [aGraphicsContext displayImage: spot at: offset + (cent - box topLeft // 2).
  146.             aGraphicsContext displayImage: spot at: offset + (cent - box bottomRight // 2)].
  147.     (#(4 5 6 ) includes: model value)
  148.         ifTrue: 
  149.             [aGraphicsContext displayImage: spot at: offset + (cent - box topRight // 2).
  150.             aGraphicsContext displayImage: spot at: offset + (cent - box bottomLeft // 2)].
  151.     6 = model value
  152.         ifTrue: 
  153.             [aGraphicsContext displayImage: spot at: offset + (cent - box leftCenter // 2).
  154.             aGraphicsContext displayImage: spot at: offset + (cent - box rightCenter // 2)]! !
  155.  
  156. !DiceView methodsFor: 'updating'!
  157.  
  158. update: aSymbol
  159.     "This is a frig to make sure all updates are visible."
  160.     self invalidateRectangle: self bounds repairNow: true! !
  161.  
  162. !DiceView methodsFor: 'bounds accessing'!
  163.  
  164. bounds: newBounds 
  165.     "Resizing the dice changes the sizes and positions of the spots."
  166.     |pixmap aGC |
  167.     super bounds: newBounds.
  168.     spotWidth := newBounds width // 6.
  169.     spotHeight := newBounds height // 6.
  170.     pixmap := Pixmap extent: spotWidth@spotHeight.
  171.     aGC := pixmap graphicsContext.
  172.     aGC displayWedgeBoundedBy: aGC clippingBounds startAngle: 0 sweepAngle: 360.
  173.     aGC paint: ColorValue gray.
  174.     aGC displayWedgeBoundedBy: (aGC clippingBounds scaledBy: 0.95) startAngle: 0 sweepAngle: 360.
  175.     
  176.     spot := pixmap asImage! !
  177. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  178.  
  179. DiceView class
  180.     instanceVariableNames: ''!
  181.  
  182.  
  183. !DiceView class methodsFor: 'instance creation'!
  184.  
  185. open 
  186.     "Create a new instance on the receiver with a new model"
  187.     "DiceView open."
  188.  
  189.     self openOn: Dice new!
  190.  
  191. openOn: aDice
  192.     "DiceView openOn: Dice new"
  193.     | window diceView |
  194.     window := ScheduledWindow new model: aDice.
  195.     window label: aDice class name.
  196.     window minimumSize: 100@100.
  197.     diceView := self new model: aDice.
  198.     window component: (BoundedWrapper on: diceView).
  199.     window open! !
  200. DiceController initialize!
  201.